home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / System source / qd < prev    next >
Text File  |  1992-03-03  |  4KB  |  146 lines
  1. \ Modification History - QuickDraw Objects
  2. \  4/27/84  CBD Version  1.00
  3. \  8/16/84  CBD Changed Set: to SetText for GrafPort
  4. \  8/16/84  CBD Added Point methods, savePort
  5. \ 10/25/84  CBD Added Image, Picture
  6. \ 11/02/84  CBD Moved image, picture to qdExt
  7. \ 11/22/84  cbd Renamed bitMap qdBitMap
  8. \ 11/23/84  cbd Added Random
  9. \ 12/14/84  cbd Trimmed down for release 1.0
  10. \ 11/16/85  cdn Added disp: method to Rect
  11. \ 12/13/91    rfl    added ptin: method to Rect
  12.  
  13. 0 Constant srcCopy    \ Equates for drawing modes
  14. 1 Constant srcOr
  15. 2 Constant srcXor
  16.  
  17. \ Random - returns a random number 0 - N. N is limited to an Int
  18. \  value. Larger than that means that numbers will be poorly distributed
  19. ( n -- rand*N )
  20. : Random   word0 call Random word0 swap mod ;
  21.  
  22. :CLASS Point  <Super Object
  23.  
  24.     Int        Y    \ Vertical coordinate
  25.     Int        X    \ Horizontal  coordinate
  26.  
  27.     :M  GETX:  get: X  ;M
  28.     :M  GETY:  get: Y  ;M
  29.     :M  GET:   get: X  get: Y   ;M    ( -- x y )
  30.     :M  PUT:   put: Y  put: X   ;M
  31.     :M  PUTX:  put: X   ;M
  32.     :M  PUTY:  put: Y   ;M
  33.     :M  INT:   M@  ;M    \ leave a long with  x:y
  34.  
  35. ;CLASS
  36.  
  37. :CLASS Rect  <Super Object
  38.  
  39.     Point    TopL
  40.     Point    BotR
  41.  
  42.     :M  GET:    get: TopL   get: BotR   ;M    ( -- l t r b )
  43.     :M  PUT:    put: BotR   put: TopL   ;M    ( l t r b -- )
  44.     :M  GETTOP:        get:  TopL  ;M
  45.     :M  GETTOPX:    getX: TopL  ;M
  46.     :M  GETTOPY:    getY: TopL  ;M
  47.     :M  PUTTOP:        put:  TopL  ;M
  48.     :M  PUTTOPX:    putX: TopL  ;M
  49.     :M  PUTTOPY:    putY: TopL  ;M
  50.     :M  GETBOT:        get:  BotR  ;M
  51.     :M  GETBOTX:    getX: BotR  ;M
  52.     :M  GETBOTY:    getY: BotR  ;M
  53.     :M  PUTBOT:        put:  BotR  ;M
  54.     :M  PUTBOTX:    putX: BotR  ;M
  55.     :M  PUTBOTY:    putY: BotR  ;M
  56.  
  57.     :M  DRAW:   abs: Self  call  FrameRect   ;M
  58.     :M  DISP:   put: self  draw: self   ;M
  59.     :M  PRINT:  draw: Self  ;M
  60.     :M  CLEAR:  abs: Self  call  EraseRect   ;M
  61.  
  62.     \ ( addr -- )  copy rect's values to address on stack
  63.     :M  =:    ^Base swap 8 cmove ;M
  64.  
  65.     \ ( ^patObj -- )  Fill rect with pattern
  66.     :M  FILL: +base abs: self swap  call FillRect   ;M
  67.  
  68.     \ ( -- width height )  calc rect's size
  69.     :M  SIZE:  getx: botr  getx: topl  -    \ compute w
  70.         gety: botr   gety: topl   - ;M
  71.  
  72.     \ ( -- x y )
  73.     :M  CENTER:   { \ x y -- }  Size: Self  2/  -> y  2/ -> x
  74.         GetX: TopL  x +    getY: topL y +   ;M
  75.     \ ( -- )
  76.     :M  INVERT: (abs) call InverRect ;M
  77.  
  78.     \ ( -- )
  79.     :M  PAINT:  (abs) call PaintRect  ;M
  80.  
  81.     \ ( -- )  clip drawing to this rect
  82.     :M  CLIP:  (abs) call ClipRect  ;M
  83.  
  84.     \ ( -- )  add rect to update region
  85.     :M  UPDATE:  (abs) call InvalRect  ;M
  86.  
  87.     \ ( dh dv -- )  Make rect smaller by dh dv
  88.     :M  INSET:  pack (abs) swap call InsetRect ;M
  89.  
  90.     \ ( dh dv -- )
  91.     :M  OFFSET: pack abs: self swap call OffsetRect  ;M
  92.  
  93.     \ ( point -- b)
  94.     :M  PTIN:  0 swap (abs) call PtInRect unpack swap drop 256 = ;M
  95.  
  96.     \ show an example of a Rect
  97.     :M  EXAMPLE:  50 50 200 150 Put: self  Draw: self   ;M
  98.  
  99. ;CLASS
  100.  
  101. ' Rect 'c fpRect !
  102.  
  103. \ A temporary rectangle, usable by anything
  104. Rect tempRect
  105.  
  106. :CLASS Grafport  <Super Object
  107.  
  108.     16 Bytes    graf1        \ unmapped
  109.     Rect        Portrect
  110.     44 Bytes    graf3
  111.     Var            Text1        \ font,face,mode,size
  112.     Var            Text2
  113.     32 Bytes    graf2        \ unmapped
  114.  
  115.     \ ( -- )  Make this GrafPort current
  116.     :M  SET:     (abs)  call SetPort    ;M
  117.  
  118.     \ ( l t r b -- )  Get values for port Rect
  119.     :M  GETRECT:   Get: portrect      ;M
  120.  
  121.     \ ( l t r b -- )  store values for portrect
  122.     :M  PUTRECT:   Put: PortRect     ;M
  123.  
  124. ;CLASS
  125.  
  126. : pushPort  0 sp@ +base call GetPort ;
  127. : popPort   call SetPort ;
  128.  
  129. \ cursors are simple data types that set themselves
  130. 1 codefields
  131.     Do..  0 swap w@ makeInt call GetCursor >ptr +base call SetCursor ..End
  132.  
  133. \ use:  resID cursor sam
  134. : Cursor  Build w,  ..End
  135.  
  136. \ predefined cursors
  137. 1 cursor iBeamCurs
  138. 2 cursor crossCurs
  139. 3 cursor plusCurs
  140. 4 cursor watchCurs
  141. : arrowCurs call InitCursor ;
  142.  
  143. 'type PAT#  0 rsrc spList    \ system pattern list
  144. \ ( pat# -- ^pattern )  return ptr to standard Mac pattern
  145. : sysPat   8 *  spList 2+ + ;
  146.